home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d893.lha
/
Clouds
/
Clouds2.9.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-21
|
24KB
|
519 lines
PROGRAM Cloudy;
{************************************************
************************************************
**** ****
**** Clouds 2.9 ****
**** ****
**** by Danny Amor in 1993 ****
**** ****
**** using KICK-PASCAL 2.1 ****
**** ****
************************************************
************************************************}
{$OPT q}
USES SupportIntuition,Intuition,IFF;
{$incl "libraries/asl.h", "asl.lib","libraries/dosextens.h"}
CONST ObereFarbe = 31;
UntereFarbe = 2;
MittlereFarbe = 17;
TYPE IDt0 = ARRAY[1..1280] OF INTEGER;
IDt1 = ARRAY[1..10] OF INTEGER;
STR_100 = STRING[100];
VAR Scr : ^Screen;
Win,Win2 : ^Window;
Msg : ^IntuiMessage;
Rp : ^Rastport;
Vp, OldPtr : PTR;
MyProcess : ^Process;
FailName,Titl : STRING[256];
ab,na,num_iter,nk,n1,n,farbe,
farbe1,farbe2,farbe3,farbe4 : WORD;
Ok,Ende : BOOLEAN;
mu,mf : REAL;
cloudybDt0,cloudybDt1,cloudybDt4,cloudybDt5 : IDt1;
cloudytattr0 : TextAttr;
cloudyitxt0 ,cloudyitxt1 ,cloudyitxt2,
cloudyitxt3 ,cloudyitxt4 ,cloudyitxt5,
cloudyitxt6 ,cloudyitxt7 ,cloudyitxt8,
cloudyitxt9 ,cloudyitxt12,cloudyitxt11 : IntuiText;
cloudyimage0 : Image;
cloudyiDT0 : ^IDt0;
cloudyborder0,cloudyborder1,cloudyborder4,
cloudyborder5 : Border;
cloudygadget0,cloudygadget1,cloudygadget2,
cloudygadget3,cloudygadget4,cloudygadget5,
cloudygadget6,cloudygadget7,cloudygadget8,
cloudygadget9 : Gadget;
clouds0 : Requester;
AktGad : ^Gadget;
resz : LONG;
resx,resy : INTEGER;
it1,it2,it3,it4,it5,itxt2,itxt3,RUS,YES,NO : IntuiText;
Req : p_FileRequester;
Tags : ARRAY[0..5] OF TagItem;
x,y,mode : LONG;
PROCEDURE ShowGadgets(w: p_Window);
VAR a: BOOLEAN;
BEGIN
cloudytattr0:=TextAttr("topaz.font",8,0,99);
cloudyitxt0:=IntuiText(25,0,0,16,3,^cloudytattr0,"QUIT",NIL);
cloudyitxt1:=IntuiText(25,27,0,16,3,^cloudytattr0,"SIZE",NIL);
cloudyitxt2:=IntuiText(25,27,0,4,3,^cloudytattr0,"4",NIL);
cloudyitxt3:=IntuiText(25,27,0,4,3,^cloudytattr0,"3",NIL);
cloudyitxt4:=IntuiText(25,27,0,4,3,^cloudytattr0,"2",NIL);
cloudyitxt5:=IntuiText(25,27,0,4,3,^cloudytattr0,"1",NIL);
cloudyitxt6:=IntuiText(1,0,0,8,3,^cloudytattr0,"",NIL);
cloudyitxt7:=IntuiText(25,27,0,4,3,^cloudytattr0,"ANIMATE",NIL);
cloudyitxt8:=IntuiText(25,0,0,8,3,^cloudytattr0,"SMOOTH",NIL);
cloudyitxt9:=IntuiText(25,0,0,16,3,^cloudytattr0,"SAVE",NIL);
cloudyitxt11:=IntuiText(1,0,2,3,75,^cloudytattr0,"1993 by",^cloudyitxt12);
cloudyitxt12:=IntuiText(1,0,2,4,87,^cloudytattr0,"D. Amor",NIL);
cloudyiDt0:=Ptr(Alloc_Mem(SizeOf(Idt0),2));
cloudyiDt0^:=IDt0(2687 ,-2245 ,-32230 ,678 ,24531 ,7313 ,-7301 ,-30724 ,-7678 ,-4221 ,-22346,
-31354 ,11313 ,-556 ,4003 ,-18938 ,-19131 ,-25035 ,-22925 ,30902 ,2927 ,-4646 ,-30028 ,-19184 ,-12944 ,2050 ,3598,
20466 ,-12812 ,15751 ,-19174 ,14297 ,-2610 ,19404 ,-32016 ,14996 ,-1812 ,-26046 ,-12023 ,6576 ,12971 ,29272 ,3409,
7608 ,12027 ,-7198 ,22644 ,23582 ,1393 ,-25024 ,-17419 ,30678 ,13605 ,-6788 ,-26675 ,27343 ,2834 ,-11157 ,5102,
8970 ,27401 ,-7106 ,1878 ,-20239 ,-26263 ,672 ,30311 ,-15117 ,4291 ,4172 ,-2365 ,-7774 ,27978 ,22021 ,-22205,
-8924 ,-25218 ,-19554 ,-26861 ,-7510 ,23694 ,20757 ,-6859 ,-2475 ,15612 ,-11939 ,31715 ,-1812 ,-26666 ,9834 ,-9604,
-5817 ,10344 ,6827 ,25815 ,-11646 ,-3984 ,4691 ,2311 ,29272 ,31052 ,-2474 ,29300 ,-3107 ,8741 ,5784 ,16902,
1169 ,18680 ,-24210 ,-24289 ,4828 ,-22833 ,12513 ,-15929 ,-29761 ,30037 ,8396 ,-23373 ,-29675 ,2505 ,-12890 ,-10640,
22329 ,-6424 ,2876 ,14032 ,-9871 ,-14106 ,9933 ,-13443 ,29063 ,-2508 ,-23827 ,132 ,-114 ,-16415 ,-7321 ,-10832,
-14086 ,26642 ,-2904 ,-20898 ,23977 ,-21334 ,-18124 ,-21412 ,9598 ,-25307 ,19724 ,6354 ,20872 ,-29128 ,6628 ,18035,
-25504 ,-15770 ,-28205 ,-9334 ,9053 ,29599 ,10538 ,28980 ,19058 ,-26776 ,-22075 ,21494 ,-28051 ,-25177 ,-24316 ,17846,
29994 ,-7372 ,32529 ,18034 ,-27890 ,30010 ,8352 ,22246 ,-27610 ,14481 ,7002 ,-8461 ,-12746 ,-26607 ,8283 ,27475,
24546 ,-4810 ,-15395 ,8118 ,-20525 ,27973 ,9839 ,12352 ,-20114 ,22983 ,13230 ,-25032 ,25966 ,-21361 ,-16827 ,-20897,
-12772 ,-31151 ,-22048 ,-18278 ,862 ,-21055 ,5354 ,-2715 ,-22226 ,-20486 ,-19607 ,-12677 ,6114 ,17134 ,7685 ,-5419,
5978 ,11670 ,10079 ,26525 ,31713 ,2328 ,-19773 ,31556 ,17899 ,-20536 ,10555 ,-30923 ,15508 ,18600 ,1605 ,6901,
-22849 ,5918 ,-25967 ,23860 ,-25371 ,-29992 ,30560 ,30297 ,23217 ,23102 ,23671 ,13593 ,28396 ,15564 ,17163 ,14508,
-5192 ,-11808 ,27733 ,-8902 ,20992 ,19711 ,29598 ,9940 ,-14977 ,27395 ,-11347 ,-15190 ,28219 ,11252 ,9989 ,-16741,
30651 ,-10362 ,-31260 ,-17657 ,9448 ,-14781 ,-158 ,23104 ,-2445 ,194 ,6489 ,1410 ,-28656 ,-7292 ,-8957 ,-12603,
-24211 ,-22333 ,-7078 ,25327 ,-32226 ,30624 ,32173 ,21843 ,14383 ,15617 ,16704 ,-7534 ,-15943 ,27116 ,26884 ,12659,
6463 ,296 ,-3373 ,4888 ,17405 ,-6090 ,-8969 ,9299 ,-2533 ,-7594 ,-4420 ,4678 ,-21695 ,-9559 ,21318 ,7428,
6414 ,-2426 ,-76 ,-23258 ,6830 ,15818 ,28596 ,-18122 ,-23917 ,-6292 ,18047 ,-9125 ,-5659 ,-26121 ,-19478 ,-25773,
-6363 ,22810 ,2794 ,-28455 ,26585 ,-1947 ,-16676 ,-14079 ,-16412 ,-21325 ,19361 ,28774 ,27438 ,-27214 ,-17723 ,13002,
362 ,-2313 ,7972 ,-6136 ,14707 ,5992 ,-16560 ,-18463 ,-27633 ,-6302 ,12965 ,-18610 ,15305 ,-13751 ,16440 ,17011,
-13905 ,-30332 ,32465 ,-29565 ,10645 ,-26163 ,-18288 ,-28462 ,-18595 ,-3462 ,16397 ,-2492 ,22081 ,-24085 ,13787 ,-29309,
4953 ,-5943 ,22179 ,2651 ,-8087 ,1015 ,26638 ,7674 ,-25390 ,17707 ,17385 ,-27674 ,-17549 ,-2256 ,23071 ,-10263,
2956 ,26627 ,12995 ,5948 ,9610 ,22105 ,-24114 ,-27244 ,20407 ,-5105 ,-4910 ,-4193 ,-12239 ,-2891 ,-4800 ,-5556,
10589 ,-639 ,-10540 ,-667 ,-20560 ,-27191 ,-30836 ,-12005 ,32146 ,-29807 ,-7581 ,-3201 ,-1145 ,-14862 ,17761 ,-19512,
-25470 ,1893 ,2591 ,-13769 ,-7726 ,-28800 ,-9955 ,-7107 ,-770 ,-2859 ,8525 ,-12285 ,21398 ,-30739 ,-1118 ,-5051,
29853 ,-10926 ,32164 ,18927 ,-1239 ,-24056 ,-31165 ,-10449 ,32319 ,-5805 ,28280 ,-5761 ,-21213 ,-12153 ,-9091 ,-19439,
-22134 ,26657 ,1850 ,-14147 ,15889 ,8841 ,-21698 ,11264 ,-8773 ,6602 ,-13443 ,30266 ,-21068 ,29324 ,-29156 ,-25459,
-2842 ,-3521 ,-8516 ,11263 ,13022 ,-30289 ,7988 ,-2284 ,-21534 ,-14947 ,-24517 ,16037 ,30620 ,310 ,-5336 ,-11883,
21871 ,-15211 ,-19404 ,-9462 ,25173 ,-24568 ,-10469 ,8664 ,1011 ,-25423 ,7968 ,2539 ,-25481 ,-7821 ,-427 ,-18586,
13179 ,-29370 ,32007 ,-27478 ,-24271 ,-1025 ,-7966 ,32551 ,32176 ,-1540 ,-7750 ,-14909 ,-18114 ,-5685 ,-9337 ,18661,
26767 ,3264 ,-26140 ,26740 ,30979 ,-6983 ,-32766 ,-4593 ,-7926 ,25658 ,-32223 ,-4922 ,-5143 ,-26887 ,19453 ,-32412,
-9874 ,23287 ,-6211 ,-32700 ,-401 ,2943 ,-909 ,-24562 ,20534 ,6385 ,-9951 ,636 ,16846 ,-23487 ,-1636 ,-14524,
8912 ,-5055 ,1407 ,-25393 ,-17902 ,-4897 ,6522 ,15379 ,-969 ,28164 ,11840 ,7200 ,-12187 ,26252 ,8853 ,5258,
14867 ,19980 ,1110 ,9867 ,-13026 ,-31378 ,12406 ,16363 ,-989 ,-25744 ,14783 ,7047 ,-2570 ,-19488 ,3094 ,22471,
-5830 ,-24022 ,8711 ,29719 ,-3026 ,-6001 ,24527 ,3302 ,25769 ,9375 ,-16790 ,-32303 ,-31817 ,6062 ,-11944 ,-13335,
-24693 ,16335 ,-100 ,4588 ,12698 ,8091 ,30528 ,16623 ,-2148 ,31647 ,-2512 ,2185 ,-3498 ,13431 ,23600 ,14860,
16052 ,-18445 ,31987 ,28708 ,1768 ,-18189 ,-18349 ,10475 ,-20368 ,-20379 ,16859 ,-31015 ,21528 ,8597 ,10213 ,31562,
21228 ,4249 ,2000 ,7634 ,-14344 ,12422 ,28287 ,-29570 ,3451 ,2128 ,-7169 ,-30655 ,20474 ,-30340 ,8412 ,-11156,
16185 ,7709 ,-5950 ,-2376 ,559 ,-19241 ,-25273 ,-40 ,-502 ,11391 ,-9917 ,6651 ,11780 ,12316 ,14535 ,-18023,
22336 ,30976 ,3031 ,1305 ,31681 ,-9469 ,-26243 ,3858 ,16133 ,-3325 ,-7266 ,4086 ,15624 ,9834 ,-14690 ,-28829,
9175 ,5354 ,3009 ,-13836 ,3882 ,-29073 ,6589 ,7616 ,-31973 ,-178 ,14798 ,15595 ,-16289 ,3929 ,-1245 ,11915,
-2537 ,-8504 ,25919 ,-8281 ,-13538 ,-11161 ,22716 ,32041 ,-11753 ,5429 ,-32577 ,30527 ,-24406 ,-32573 ,-15730 ,-24785,
-24107 ,-5899 ,15552 ,10337 ,350 ,-4357 ,-25549 ,-3074 ,-24828 ,-455 ,-25475 ,-1539 ,23615 ,-27867 ,4159 ,-690,
31611 ,29181 ,-1797 ,-9089 ,3715 ,20129 ,14268 ,5212 ,28379 ,16551 ,9532 ,6228 ,-53 ,-13940 ,11129 ,3716,
-1088 ,18411 ,-18225 ,9785 ,122 ,1781 ,-11314 ,7723 ,-29188 ,23217 ,20808 ,17928 ,5002 ,29943 ,-937 ,2274,
15382 ,28824 ,-1448 ,19161 ,-16335 ,2047 ,-254 ,7 ,-576 ,2047 ,-448 ,14851 ,-64 ,6143 ,-904 ,-2297,
-144 ,1023 ,32283 ,-2169 ,-4 ,-7170 ,32765 ,-3697 ,-4 ,25597 ,32767 ,-3322 ,-2 ,-3586 ,14335 ,-124,
-144 ,-1544 ,7167 ,-128 ,-400 ,-1808 ,1023 ,-128 ,30776 ,-1026 ,9983 ,-640 ,16880 ,-7170 ,1635 ,-1912,
992 ,-7170 ,0 ,-8192 ,992 ,-7200 ,6145 ,-16372 ,1984 ,-7688 ,11779 ,-8161 ,924 ,-16016 ,520 ,-6017,
-15365 ,-15888 ,1033 ,-10113 ,-3585 ,-32110 ,9 ,-16353 ,-1796 ,-32640 ,0 ,-8129 ,-1544 ,-32768 ,1 ,-8129,
-3792 ,-32758 ,8705 ,-5137 ,-2000 ,-8049 ,-61 ,-3073 ,-1998 ,9375 ,-25 ,-1 ,-968 ,6078 ,-57 ,-521,
-500 ,16383 ,-125 ,-13 ,-12772 ,8187 ,-2225 ,-16 ,2064 ,32767 ,-2545 ,-16 ,3160 ,15999 ,23567 ,-528,
184 ,16383 ,31948 ,-8 ,254 ,14591 ,-18228 ,-196 ,-20354 ,12415 ,16832 ,31038 ,21534 ,8703 ,10208 ,60,
21118 ,247 ,2032 ,44 ,-16258 ,249 ,28287 ,-32768 ,636 ,127 ,-7169 ,-32712 ,124 ,-32385 ,-7969 ,-11248,
62 ,31 ,-7997 ,-2496 ,44 ,-30465 ,-32313 ,31776 ,-452 ,4223 ,-15933 ,-2045 ,-450 ,2108 ,8647 ,-2047,
-130 ,256 ,983 ,-767 ,-2 ,8963 ,-32259 ,-237 ,-2 ,771 ,-7169 ,-9 ,-7 ,2018 ,-14337 ,32739,
-13 ,2016 ,3070 ,14327 ,-5 ,-28704 ,6594 ,1023 ,32740 ,-64 ,14768 ,1020 ,16352 ,-28735 ,-1060 ,4604,
2528 ,-8256 ,26048 ,8280 ,13543 ,-2080 ,192 ,214 ,11751 ,-272 ,192 ,192 ,24535 ,32576 ,240 ,24816,
24544 ,6130 ,-16129 ,-2050 ,-160 ,4600 ,24639 ,-1 ,32568 ,504 ,24701 ,-1 ,-968 ,3564 ,-8129 ,-49,
-3972 ,4092 ,255 ,-1 ,284 ,14240 ,-13377 ,-2084 ,4500 ,16256 ,-9921 ,-12 ,16 ,14209 ,-11399 ,-140,
112 ,15232 ,16639 ,-8 ,96 ,32258 ,9215 ,-8 ,4064 ,9806 ,-24193 ,-8 ,8176 ,3080 ,104 ,-226,
16352 ,3073 ,-32672 ,16135 ,-50 ,-1 ,-3 ,-8 ,512 ,-1 ,-1 ,-4 ,0 ,-1 ,-1 ,-8,
0 ,-1 ,-1 ,-8 ,0 ,8191 ,-1 ,-16 ,0 ,-24577 ,-1 ,-7 ,0 ,4095 ,-1 ,-5,
128 ,2047 ,-1 ,-1 ,384 ,2047 ,-1 ,-1 ,-30784 ,2047 ,-1 ,-1 ,-16896 ,8191 ,-1 ,-1,
-1024 ,8191 ,-1 ,-1 ,-1024 ,8191 ,-6145 ,-1 ,-2048 ,8191 ,-11777 ,-1 ,-1022 ,16383 ,-513 ,-1,
-1018 ,16383 ,-1025 ,-1 ,-512 ,32765 ,-1 ,-1 ,-256 ,32767 ,-1 ,-1 ,-512 ,32767 ,-1 ,-1,
-320 ,32757 ,-8705 ,-1 ,-64 ,8048 ,63 ,-1 ,-64 ,-9376 ,31 ,-1 ,-64 ,-6079 ,63 ,-1,
-16 ,-16384 ,127 ,-1 ,-32 ,-8188 ,2239 ,-1 ,-32 ,-32768 ,2559 ,-1 ,-96 ,-16000 ,-23553 ,-1,
-192 ,-16384 ,-31937 ,-1 ,-256 ,-14592 ,18239 ,-1 ,20352 ,-12416 ,-16833 ,-1 ,-21536 ,-8704 ,-10209 ,-1,
-21120 ,-256 ,-2033 ,-1 ,16256 ,-256 ,-28288 ,32767 ,-128 ,-128 ,7168 ,32767 ,-128 ,32384 ,7968 ,11263,
-64 ,-32 ,7996 ,2559 ,-48 ,32512 ,32312 ,1023 ,448 ,-128 ,15932 ,2044 ,448 ,-61 ,-8648 ,2046,
128 ,-257 ,-984 ,766 ,0 ,-772 ,32258 ,236 ,0 ,-772 ,7168 ,8 ,6 ,-2019 ,14336 ,28,
14 ,-2017 ,-3072 ,8 ,4 ,28703 ,-6656 ,0 ,0 ,63 ,-14848 ,0 ,0 ,28734 ,1024 ,0,
0 ,8255 ,-26112 ,0 ,0 ,2079 ,-256 ,0 ,2 ,15 ,-256 ,0 ,0 ,63 ,-256 ,0,
0 ,15 ,-256 ,0 ,128 ,7 ,-64 ,0 ,192 ,7 ,-126 ,0 ,960 ,19 ,-64 ,48,
3968 ,3 ,-256 ,0 ,-32 ,95 ,-960 ,2083 ,-32 ,127 ,-320 ,11 ,-32 ,127 ,-890 ,11,
-128 ,127 ,-256 ,7 ,-128 ,511 ,-1024 ,7 ,-4096 ,511 ,-384 ,7 ,-8192 ,1023 ,-128 ,1,
-16384 ,1023 ,-128 ,0 ,0 );
cloudyimage0:=Image(0, 0, 64, 64, 5,cloudyiDt0, 31, 0,NIL);
cloudybDt0:=IDt1(1,1,1,12,0,13,0,0,62,0);
cloudyborder0:=Border(0, 0, 26, 0, 0, 5,^cloudybDt0,^cloudyborder1);
cloudybDt1:=IDt1(62,13,62,1,63,0,63,13,1,13);
cloudyborder1:=Border(0, 0, 1, 0, 0, 5,^cloudybDt1,NIL);
cloudybDt4:=IDt1(1,1,1,12,0,13,0,0,14,0);
cloudyborder4:=Border(0, 0, 26, 0, 0, 5,^cloudybDt4,^cloudyborder5);
cloudybDt5:=IDt1(14,13,14,1,15,0,15,13,1,13);
cloudyborder5:=Border(0, 0, 1, 0, 0, 5,^cloudybDt5,NIL);
cloudygadget0:=Gadget(^cloudygadget1, 0, 175, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt0,0, NIL, 0, PTR(-1));
cloudygadget1:=Gadget(^cloudygadget2, 0, 98, 64, 14, GADGHNONE, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt1,0, NIL, 1, PTR(-1));
cloudygadget2:=Gadget(^cloudygadget3, 48, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt2,0, NIL, 2, PTR(-1));
cloudygadget3:=Gadget(^cloudygadget4, 32, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt3,0, NIL, 3, PTR(-1));
cloudygadget4:=Gadget(^cloudygadget5, 16, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt4,0, NIL, 4, PTR(-1));
cloudygadget5:=Gadget(^cloudygadget6, 0, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt5,0, NIL, 5, PTR(-1));
cloudygadget6:=Gadget(^cloudygadget7, 0, 7, 64, 64, GADGHNONE+GADGIMAGE, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyimage0, NIL, ^cloudyitxt6,0, NIL, 6, PTR(-1));
cloudygadget7:=Gadget(^cloudygadget8, 0, 130, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt7,0, NIL, 7, PTR(-1));
cloudygadget8:=Gadget(^cloudygadget9, 0, 145, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt8,0, NIL, 8, PTR(-1));
cloudygadget9:=Gadget(NIL, 0, 160, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt9,0, NIL, 9, PTR(-1));
InitRequester( ^clouds0);
clouds0.LeftEdge := 0;
clouds0.TopEdge := 10;
clouds0.Width := 64;
clouds0.Height := 200;
clouds0.ReqGadget := ^cloudygadget0;
clouds0.ReqBorder := NIL;
clouds0.ReqText := ^cloudyitxt11;
clouds0.Flags := 0;
clouds0.BackFill := 0;
a:=Request(^clouds0,w);
END;
PROCEDURE TestF(VAR farbe: WORD);
BEGIN
IF farbe>ObereFarbe THEN farbe:=ObereFarbe;
IF farbe<UntereFarbe THEN farbe:=UntereFarbe
END;
PROCEDURE RandomFarbe(VAR Rp: p_RastPort; Start: WORD; VAR mf: REAL;
x,y: INTEGER);
VAR farbe,a: WORD;
BEGIN
farbe:=Start+SUCC(ROUND(RANDOM*mf*LONG(2)-mf));
TestF(farbe);
SetAPen(Rp,farbe);
a:=WritePixel(Rp,x,y);
END;
PROCEDURE Cloud;
TYPE Coord = ARRAY [1..10] OF WORD;
VAR i,j,k,l,smul1,smul2,x1,y1,x2,y2,x3,y3: WORD;
xy : Coord;
PROCEDURE BigPic(n,i: WORD; VAR n1,l: WORD);
BEGIN
n1:=n SHR 1;
IF n1=127 THEN INC(n1);
l:=1 SHL i;
IF l=0 THEN DEC(l);
END;
PROCEDURE SetEdge(VAR Rp: p_RastPort; x1,y1,x2,y2,x3,y3: WORD;
VAR mf: REAL);
BEGIN
farbe1:=ReadPixel(Rp,x1,y1);
farbe2:=ReadPixel(Rp,x2,y2);
RandomFarbe(Rp,(farbe1+farbe2) SHR 1,mf,x3,y3);
END;
PROCEDURE SetPoint(VAR Rp: p_RastPort; VAR mf: REAL;
VAR xy: Coord);
VAR a: INTEGER;
BEGIN
farbe1:=ReadPixel(Rp,xy[1],xy[2]);
farbe2:=ReadPixel(Rp,xy[3],xy[4]);
farbe3:=ReadPixel(Rp,xy[5],xy[6]);
farbe4:=ReadPixel(Rp,xy[7],xy[8]);
farbe:=(farbe1+farbe2+farbe3+farbe4) SHR 2+ROUND(RANDOM*2*mf-mf);
TestF(farbe);
SetAPen(Rp,farbe);
a:=WritePixel(Rp,xy[9],xy[10]);
END;
BEGIN
SetAPen(Rp,0);
RectFill(Rp,0,0,256,256);
RANDOMIZE;
mf:=SUCC(num_iter)*mu;
RandomFarbe(Rp,MittlereFarbe,mf,0, 0);
RandomFarbe(Rp,MittlereFarbe,mf,0, na);
RandomFarbe(Rp,MittlereFarbe,mf,na, 0);
RandomFarbe(Rp,MittlereFarbe,mf,na,na);
n:=na;
FOR i:=0 TO num_iter DO
BEGIN
mf:=SUCC(num_iter-i)*mu;
Bigpic(n,i,n1,l);
FOR j:=1 TO l DO
BEGIN
smul1:=PRED(j)*n;
smul2:=j*n;
SetEdge(Rp,smul1,0 ,smul2,0 ,smul2-n1,0 ,mf);
SetEdge(Rp,smul1,na ,smul2,na ,smul2-n1,na ,mf);
SetEdge(Rp,0 ,smul1,0 ,smul2,0 ,smul2-n1,mf);
SetEdge(Rp,na ,smul1,na ,smul2,na ,smul2-n1,mf);
END;
n:=n1;
END;
n:=na;
FOR i:=0 TO num_iter DO
BEGIN
mf:=SUCC(num_iter-i)*mu;
BigPic(n,i,n1,l);
FOR k:=1 TO l DO
FOR j:=1 TO l DO
BEGIN
smul1:=k*n; smul2:=j*n;
xy:=Coord(smul2-n,smul1-n,smul2-n,smul1,smul2,smul1-n,
smul2,smul1,smul2-n1,smul1-n1);
SetPoint(Rp,mf,xy);
END;
nk:=0;
FOR k:=1 TO PRED(1 SHL SUCC(i)) DO
BEGIN
nk:=1-nk;
FOR j:=1 TO (1 SHL i)-nk DO
BEGIN
smul1:=j*n+nk*n1; smul2:=k*n1;
xy:=Coord(smul1-n1,smul2-n1,smul1,smul2,smul1-n1,smul2+n1,
smul1-n,smul2,smul1-n1,smul2);
SetPoint(Rp,mf,xy);
END;
END;
n:=n1;
END;
END;
PROCEDURE SizeOut(VAR na,num_iter: WORD; VAR mu: REAL; faktor: WORD);
BEGIN
faktor:=7-faktor;
IF resz=0 THEN
BEGIN
na:=8 SHL faktor;
num_iter:=2+faktor;
END
ELSE
BEGIN
na:=16 SHL faktor;
num_iter:=3+faktor;
END;
mu:=2.5-faktor/5;
Cloud;
END;
PROCEDURE Smooth(VAR na: WORD);
VAR y,x,a: WORD;
BEGIN
FOR y:=0 TO PRED(na) DO
FOR x:=0 TO PRED(na) DO
BEGIN
farbe1:=ReadPixel(Rp,x,y);
farbe2:=ReadPixel(Rp,SUCC(x),y);
farbe3:=ReadPixel(Rp,x,SUCC(y));
farbe4:=ReadPixel(Rp,SUCC(x),SUCC(y));
farbe :=(farbe1+farbe2+farbe3+farbe4) SHR 2;
SetAPen(Rp,farbe);
a:=WritePixel(Rp,x,y);
END;
END;
PROCEDURE anim(vp: PTR);;
VAR a,i,k,nh,n: WORD;
nf: SHORT;
BEGIN
nh:=0; nf:=1; n:=2;
FOR k:=1 TO 22 DO
BEGIN
FOR i:=1 TO 11-nh DO
BEGIN
SetRGB4(Vp,n,0,0,15);
INC(n);
END;
FOR i:=2 TO 14 DO
BEGIN
SetRGB4(Vp,n,i,i,15);
INC(n);
END;
SetRGB4(Vp,n,15,15,15);
INC(n);
FOR i:=14 DOWNTO 10 DO
BEGIN
SetRGB4(Vp,n,i,i,SUCC(i));
INC(n);
END;
FOR i:=1 TO nh DO
BEGIN
a:=1;
IF i>2 THEN a:=5-i;
IF i>7 THEN a:=i-10;
a:=(10-a);
SetRGB4(Vp,n,a,a,SUCC(a));
INC(n);
END;
nh:=nh+nf;
IF (nh=0) OR (nh=11) THEN nf:=-nf;
n:=2;
END;
END;
FUNCTION GetFileName(fname: STR_100): BOOLEAN;
VAR Req : p_FileRequester;
Tags : ARRAY[0..4] OF TagItem;
FileName : STRING[100];
DirName : STRING[100];
VailName : STRING[100];
Cancel : Boolean;
BEGIN
AslBase:=OpenLibrary(ASLNAME,36);
IF AslBase<>NIL THEN
BEGIN
Cancel:=FALSE;
DirName :="RAM:";
FileName :="";
Tags[0].ti_Tag:=ASL_Hail;
Tags[0].ti_Data:="Save Clouds as...";
Tags[1].ti_Tag:=ASL_File;
Tags[1].ti_Data:=FileName;
Tags[2].ti_Tag:=ASL_Dir;
Tags[2].ti_Data:=DirName;
Tags[3].ti_Tag:=ASL_Dummy+40;
Tags[3].ti_Tag:=^Scr;
Tags[4].ti_Tag:=TAG_DONE;
Req:=AllocAslRequest(ASL_FileRequest,^Tags);
IF Req<>NIL THEN
BEGIN
Cancel:=RequestFile(Req);
IF NOT Cancel THEN fName:=Req^.rf_Dir+Req^.rf_File
ELSE fName:=CHR(0);
FreeAslRequest(Req);
END;
CloseLibrary(AslBase);
GetFileName:=Cancel;
END;
END;
PROCEDURE ReqHelpHelpHelp;
BEGIN
MyProcess^.pr_WindowPTR:=OldPtr;
END;
BEGIN
MyProcess:=PTR(FindTask(NIL));
OldPtr:=MyProcess^.pr_WindowPTR;
MyProcess^.pr_WindowPTR:=Win;
AddExitServer(ReqHelpHelpHelp);
RUS:=IntuiText(2,1,0,5,3,NIL,'Are you sure?',NIL);
Yes:=IntuiText(2,1,0,5,3,NIL,'Yes',NIL);
No:=IntuiText(2,1,0,5,3,NIL,'No',NIL);
AslBase:=OpenLibrary(ASLNAME,38);
IF AslBase<>NIL THEN
BEGIN
Req:=AllocAslRequest(2,NIL);
IF Req<>NIL THEN
BEGIN
OK:=RequestFile(Req);
IF OK THEN
BEGIN
{I didn't have the OS 3.0-Includes, so I had to guess}
mode:=LONG(Req^.rf_Reserved1);
resx:=WORD(LONG(Req^.rf_File));
resy:=WORD(LONG(Req^.rf_Dir));
Tags[0].ti_Tag:=SA_WIDTH; Tags[0].ti_Data:=resx;
Tags[1].ti_Tag:=SA_HEIGHT; Tags[1].ti_Data:=resy;
Tags[2].ti_Tag:=SA_DEPTH; Tags[2].ti_Data:=5;
Tags[3].ti_Tag:=SA_TYPE; Tags[3].ti_Data:=CUSTOMSCREEN;
Tags[4].ti_Tag:=SA_DISPLAYID;Tags[4].ti_Data:=mode;
Tags[5].ti_Tag:=TAG_DONE;
Scr := OpenExtScreen( NIL, ^Tags, FALSE);
END
ELSE ERROR("HallO");
FreeAslRequest(Req);
END
ELSE WRITELN("Kann Struktur nicht anlegen !");
CloseLibrary(AslBase);
END
ELSE
BEGIN
it1:=IntuiText(2,1,0,5,3,NIL,"Welcome to CLOUDS v3.0!!! ",^it2);
it2:=IntuiText(2,1,0,5,13,NIL,"This program is pure Public Domain ",^it3);
it3:=IntuiText(2,1,0,5,23,NIL,"I hope you like it!!",^it4);
it4:=IntuiText(2,1,0,5,33,NIL,"You haven't got Workbench v2.1!!!",^it5);
it5:=IntuiText(2,1,0,5,43,NIL,"So you can't choose any resolution...",NIL);
itxt2:=IntuiText(2,1,0,5,3,NIL,"OK",NIL);
itxt3:=IntuiText(2,1,0,5,3,NIL,"OK",NIL);
OK:=autorequest(NIL,^it1,^itxt2,^itxt3,0,0,300,60);
resx:=320;
resy:=256;
resz:=0;
Scr:=Open_Screen(0,0,resx,resy,5,0,1,resz,NIL);
END;
Win:=Open_Window(0,0,resx,resy,0,0,BORDERLESS OR ACTIVATE,NIL,Scr,0,0,0,0);
Win2:=Open_Window(0,0,64,200,1,GADGETUP OR GADGETDOWN,
WINDOWDRAG OR BORDERLESS OR ACTIVATE,"CLOUDS ",Scr,0,0,0,0);
Vp:=^Scr^.ViewPort;
Rp:=Win^.RPort;
SetRGB4(Vp,0, 0, 0, 0);
SetRGB4(Vp,1,10,10,10);
Anim(vp);;
ShowGadgets(Win2);
Ende:=FALSE;
REPEAT
Msg:=Wait_Port(Win2^.UserPort);
Msg:=Get_Msg(Win2^.UserPort);
CASE Msg^.Class OF
GADGETDOWN:
BEGIN
AktGad:=Msg^.IAddress;
CASE AktGad^.GadgetID OF
0 : Ende:=AutoRequest(Win2,^RUS,^Yes,^No,0,0,100,50);
2..5: SizeOut(na,num_iter,mu,BYTE(AktGad^.GadgetID));
7 : Anim(vp);
8 : Smooth(na);
9 : BEGIN
na:=na SHL 1;
IF (na MOD 8)<>0 THEN ab:=SUCC(na DIV 8)
ELSE ab:=na DIV 8;
IF GetFileName(FailName) THEN
SaveBrush(Win,FailName,0,0,ab,na);
END;
OTHERWISE BEGIN END;
END;
END;
OTHERWISE BEGIN END;
END;
Reply_Msg(Msg);
UNTIL Ende;
END;